#
# Classifier for Qmail messages
#
package Mail::Bounce::Qmail;
use strict;
use vars qw(@ISA @patterns);

#$Mail::Bounce::Heuristic::DEBUG = 1;

@ISA = qw(Mail::Bounce::Heuristic);

$patterns[0] = << 'EoF';
Hi. This is the qmail-send program at ${MTA-\S+}.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

${RECIP-\S+}:
${ERROR-.+}. (#${CODE-\S+})
EoF

$patterns[1] = << 'EoF';
Hi. This is the qmail-send program at ${MTA-\S+}.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

${RECIP-\S+}:
${-\S+} does not like recipient.
Remote host said: ${CODE-\d+} ${ERROR-.+}
Giving up on ${-\S+}.
EoF

# this pattern is from c004.sfo.cp.net, which isn't there any more.
# (message from nov 1999).
# May be called "cpmta" not "qmail", but uses "failure notice" as subject line
# and "MAILER-DAEMON" as sender, just as some qmails. Early code?

$patterns[2] = << 'EoF';
This is the mail transport agent at ${MTA-\S+}.
This message could not be delivered.

<${RECIP-\S+}>:
${ERROR-.+}

--- Below this line is a copy of the message.
EoF

# pattern from domain.altern.com
$patterns[3] = << 'EoF';
Hi. This is the qmail-send program at ${MTA-\S+}.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

${RECIP-\S+}:
${-\S+} does not like recipient.
Remote host said: ${CODE-\d+} ${ERROR-.+}
Giving up.
EoF

# pattern from dell1.bentium.net.
# somewhat general. Should parse this further.
$patterns[4] = << 'EoF';
Hi. This is the qmail-send program at ${MTA-\S+}.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

${RECIP-\S+}:
${DIAGNOSTIC-(?s:.*)}

--- Below this line is a copy of the message.
EoF

# pattern from email04.aon.at
# as above, but more blank lines.
$patterns[5] = << 'EoF';
Hi. This is the qmail-send program at ${MTA-\S+}.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.



${RECIP-\S+}:
${DIAGNOSTIC-(?s:.*)}

--- Below this line is a copy of the message.
EoF

# pattern from mail.shasta.com
# as above, but junk added.
$patterns[6] = << 'EoF';
Hi. This is the ${-.*} at ${MTA-\S+}.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

${-.*}

${RECIP-\S+}:
${DIAGNOSTIC-(?s:.*)}

--- Below this line is a copy of the message.
EoF

# pattern from imaptest.wlv.netzero.net
# as above, but different.
$patterns[6] = << 'EoF';
Hi. This is the ${-.*} mail server.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

${RECIP-\S+}:
${DIAGNOSTIC-(?s:.*)}

--- Below this line is a copy of the message.
EoF

# pattern from intekom.com
# as above, but junk added.
$patterns[7] = << 'EoF';
Hi. This is the ${-.*} at ${MTA-\S+}.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

${-(?s:.*)}

${RECIP-\S+}:
${DIAGNOSTIC-(?s:.*)}

--- Below this line is a copy of the message.
EoF

# pattern from pandora.be
# as above, but even more geenric junkskipping.
$patterns[8] = << 'EoF';
Hi. This is the ${-.*} at ${MTA-\S+}.
${JUNK-(?s:.*)}

${RECIP-\S+}:
${DIAGNOSTIC-(?s:.*)}

--- Below this line is a copy of the message.
EoF

# pattern from altern.org
# Diagnostic missing
$patterns[9] = << 'EoF';
Hi. This is the ${-.*} at ${MTA-\S+}.
${JUNK-(?s:.*)}

${RECIP-\S+}:

--- Below this line is a copy of the message.
EoF

sub validate {
    my $self = shift;

    my $keywords = $self->patternmatch($self->firstbodystring, @patterns);
    return defined($keywords);
}

sub recipients {
    my $self = shift;

    my $keywords = $self->patternmatch($self->firstbodystring, @patterns);
    if (defined($keywords)) {
	if (wantarray()) {
	    my $res = new Mail::Bounce::Address;
	    $res->type("permfail");
	    $res->action("failed");
	    if ($$keywords{CODE}) {
		if ($$keywords{CODE} eq "550") {
		    $res->status("5.1.1 (Unknown user)");
		}
		$res->diagnostic("QMail; " . $$keywords{CODE} . " " . $$keywords{ERROR});
	    } elsif ($$keywords{DIAGNOSTIC}) {
		if ($$keywords{DIAGNOSTIC} =~ /Disk Quota Exceeded/
		    || $$keywords{DIAGNOSTIC} =~ /Account mailbox is full/) {
		    $res->type("tempfail");
		    $res->status("4.0.0 (Disk Quota Exceeded)");
		} elsif ($$keywords{DIAGNOSTIC} =~ /\(#(\d+.\d+.\d+)\)/) {
		    # Qmail's bow to standardized error codes
		    $res->status($1);
                } else {
                    $res->status("5.0.0");
		}
	    } else {
		$res->type("permfail");
		$res->status("5.0.0 (No diagnostic from Qmail)");
	    }
	    my $recip = $$keywords{RECIP};
	    if ($recip =~ /^<(.*)>$/) {
		$recip = $1;
	    }
	    $res->final_recipient("RFC822; " . $recip);
	    return $res;
	} else {
	    return 1;
	}
    } else {
	die "Qmail: Unmatched pattern in recipients()\n";
    }
}
1;




